home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Developers / SIOD 3.0 / sql_oracle.scm < prev    next >
Encoding:
Text File  |  1994-10-01  |  1.6 KB  |  57 lines  |  [TEXT/ttxt]
  1. ;;-*-mode:lisp-*-
  2. ;; For use with the ORACLE CALL INTERFACE (OCI) interface to SIOD.
  3. ;;
  4. ;; siod -g0 -h150000 -isql_oracle.scm
  5. ;;
  6. ;; Procedures: (oracle-sql-init "username" "password")
  7. ;;             (oracle-sql "string") => result of operation.
  8. ;;             (oracle-show-tables) => list user tables.
  9.  
  10. (define *oracle-sql-username* "system")
  11. (define *oracle-sql-password* "manager")
  12. (define *oracle-sql-association* nil)
  13.  
  14. (define (oracle-sql-init . args)
  15.   (if (null? *oracle-sql-association*)
  16.       (begin (oracle-login
  17.           (or (car args) *oracle-sql-username*)
  18.           (if (cdr args) (car (cdr args)) *oracle-sql-password*))
  19.          (set! *oracle-sql-association* t))))
  20.  
  21. (define (unwind-protected l1 l2)
  22.   (let ((x (*catch 'errobj (l1))))
  23.     (l2)
  24.     x))
  25.  
  26. (define (oracle-sql str)
  27.   (oracle-sql-init)
  28.   (let ((s nil)
  29.     (n nil)
  30.     (j 0)
  31.     (result nil)
  32.     (tmp nil))
  33.     (unwind-protected
  34.      (lambda ()
  35.        (set! s (oracle-sql-prepare str))
  36.        (set! n (oracle-nselects s))
  37.        (oracle-execute s)
  38.        (if (> n 0)
  39.        (begin (while (< j n)
  40.             (set! tmp (cons (oracle-select-column-name s j) tmp))
  41.             (set! j (+ 1 j)))
  42.           (set! result (cons (nreverse tmp) nil))
  43.           (while (oracle-fetch s)
  44.             (set! j 0)
  45.             (set! tmp nil)
  46.             (while (< j n)
  47.               (set! tmp (cons (oracle-select-column-value s j) tmp))
  48.               (set! j (+ 1 j)))
  49.             (set! result (cons (nreverse tmp) result)))
  50.           (set! result (nreverse result))))
  51.        result)
  52.      (lambda ()
  53.        (if s (oracle-sql-release s))))))
  54.  
  55. (define (oracle-show-tables)
  56.   (oracle-sql "select * from user_catalog"))
  57.